home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / hugenum / huge_num.pas next >
Pascal/Delphi Source File  |  1995-12-22  |  11KB  |  441 lines
  1. This unit uses an array of bytes to represent a LARGE number. The number is binairy-stored in the array, with the 
  2. Least Significant Byte (LSB) first and the Most Significant Byte (MSB) last, like all Intel-integer types.
  3.  
  4. Arithmetic is not 10-based or 2-based, but 256-based, so that each byte represents one (1) digit.
  5.  
  6. The HugeInttype numbers are Signed Numbers.
  7.  
  8.  
  9. When Compiled with the R+ directive, ADD and MUL wil generate an "Arithmetic Overflow Error" 
  10. (RunError(215)) when needed. Otherwise use the "HugeIntCarry" variable.
  11.  
  12. Use the "HugeIntDiv0" variable to check on division by zero.
  13.  
  14. Use {$DEFINE HugeInt_xx } or "Conditional defines" from the "Compiler options" for sizing, where xx is 64, 32 or 
  15. 16, otherwhise HugeIntSize will be set to 8 bytes.
  16.  
  17.  
  18. unit HugeInts;
  19. interface
  20.  
  21. const
  22. {$IFDEF HugeInt_64 }
  23.   HugeIntSize = 64;
  24.  
  25. {$ELSE}{$IFDEF HugeInt_32 }
  26.   HugeIntSize = 32;
  27. {$ELSE}{$IFDEF HugeInt_16 }
  28.   HugeIntSize = 16;
  29. {$ELSE}
  30.   HugeIntSize = 8;
  31. {$ENDIF}{$ENDIF}{$ENDIF}
  32.   HugeIntMSB  = HugeIntSize-1;
  33.  
  34. type
  35.   HugeInt = array[0..HugeIntMSB] of Byte;
  36.  
  37. const
  38.   HugeIntCarry: Boolean = False;
  39.   HugeIntDiv0:  Boolean = False;
  40.  
  41.  
  42. procedure HugeInt_Min(var a: HugeInt);                 { a := -a }
  43. procedure HugeInt_Inc(var a: HugeInt);                 { a := a + 1 }
  44. procedure HugeInt_Dec(var a: HugeInt);                 { a := a - 1 }
  45.  
  46. procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt);  { R := a + b }
  47. procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt);  { R := a - b }
  48. procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt);  { R := a * b }
  49. procedure HugeInt_Div(a, b: HugeInt; var R: HugeInt);  { R := a div b }
  50. procedure HugeInt_Mod(a, b: HugeInt; var R: HugeInt);  { R := a mod b }
  51.  
  52. function HugeInt_IsNeg(a: HugeInt): Boolean;
  53. function HugeInt_Zero(a: HugeInt): Boolean;
  54. function HugeInt_Odd(a: HugeInt): Boolean;
  55.  
  56. function HugeInt_Comp(a, b: HugeInt): Integer;          {-1:a<b; 0; 1:a>b 
  57. }
  58. procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt);{ Dest := Src }
  59.  
  60. procedure String2HugeInt(AString: string; var a: HugeInt);
  61. procedure Integer2HugeInt(AInteger: Integer; var a: HugeInt);
  62. procedure HugeInt2String(a: HugeInt; var S: string);
  63.  
  64.                              implementation
  65.  
  66. procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt);
  67. { Dest := Src }
  68. begin
  69.   Move(Src, Dest, SizeOf(HugeInt));
  70.  
  71. end;{ HugeInt_Copy }
  72.  
  73. function HugeInt_IsNeg(a: HugeInt): Boolean;
  74. begin
  75.   HugeInt_IsNeg := a[HugeIntMSB] and $80 > 0;
  76. end;{ HugeInt_IsNeg }
  77.  
  78. function HugeInt_Zero(a: HugeInt): Boolean;
  79. var i: Integer;
  80. begin
  81.   HugeInt_Zero := False;
  82.   for i := 0 to HugeIntMSB do
  83.     if a[i] <> 0 then Exit;
  84.   HugeInt_Zero := True;
  85. end;{ HugeInt_Zero }
  86.  
  87. function HugeInt_Odd(a: HugeInt): Boolean;
  88. begin
  89.   HugeInt_Odd := a[0] and 1 > 0;
  90. end;{ HugeInt_Odd }
  91.  
  92. function HugeInt_HCD(a: HugeInt): Integer;
  93.  
  94. var i: Integer;
  95. begin
  96.   i := HugeIntMSB;
  97.   while (i > 0) and (a[i] = 0) do Dec(i);
  98.   HugeInt_HCD := i;
  99. end;{ HugeInt_HCD }
  100.  
  101. procedure HugeInt_SHL(var a: HugeInt; Digits: Integer);
  102. { Shift "a" "Digits", digits (bytes) to the left,
  103.   "Digits" bytes will 'fall off' on the MSB side
  104.   Fill the LSB side with 0's }
  105. var t: Integer;
  106. b: HugeInt;
  107. begin
  108.   if Digits > HugeIntMSB then
  109.     FillChar(a, SizeOf(HugeInt), 0)
  110.   else if Digits > 0 then
  111.     begin
  112.       Move(a[0], a[Digits], HugeIntSize-Digits);
  113.  
  114.       FillChar(a[0], Digits, 0);
  115.     end;{ else if }
  116. end;{ HugeInt_SHL }
  117.  
  118. procedure HugeInt_SHR(var a: HugeInt; Digits: Integer);
  119. var t: Integer;
  120. begin
  121.   if Digits > HugeIntMSB then
  122.     FillChar(a, SizeOf(HugeInt), 0)
  123.   else if Digits > 0 then
  124.     begin
  125.       Move(a[Digits], a[0], HugeIntSize-Digits);
  126.       FillChar(a[HugeIntSize-Digits], Digits, 0);
  127.     end;{ else if }
  128. end;{ HugeInt_SHR }
  129.  
  130. procedure HugeInt_Inc(var a: HugeInt);
  131. { a := a + 1 }
  132. var
  133.   i: Integer;
  134.  
  135.   h: Word;
  136. begin
  137.   i := 0; h := 1;
  138.   repeat
  139.     h := h + a[i];
  140.     a[i] := Lo(h);
  141.     h := Hi(h);
  142.     Inc(i);
  143.   until (i > HugeIntMSB) or (h = 0);
  144.   HugeIntCarry := h > 0;
  145.   {$IFOPT R+ }
  146.     if HugeIntCarry then RunError(215);
  147.   {$ENDIF}
  148. end;{ HugeInt_Inc }
  149.  
  150. procedure HugeInt_Dec(var a: HugeInt);
  151. { a := a - 1 }
  152. var Minus_1: HugeInt;
  153. begin
  154.   { this is the easy way out }
  155.   FillChar(Minus_1, SizeOf(HugeInt), $FF); { -1 }
  156.   HugeInt_Add(a, Minus_1, a);
  157. end;{ HugeInt_Dec }
  158.  
  159.  
  160. procedure HugeInt_Min(var a: HugeInt);
  161. { a := -a }
  162. var i: Integer;
  163. begin
  164.   for i := 0 to HugeIntMSB do
  165.     a[i] := not a[i];
  166.   HugeInt_Inc(a);
  167. end;{ HugeInt_Min }
  168.  
  169. function HugeInt_Comp(a, b: HugeInt): Integer;
  170. { a = b: ==0; a > b: ==1; a < b: ==-1 }
  171. var
  172.   A_IsNeg, B_IsNeg: Boolean;
  173.   i:                Integer;
  174. begin
  175.   A_IsNeg := HugeInt_IsNeg(a);
  176.   B_IsNeg := HugeInt_IsNeg(b);
  177.   if A_IsNeg xor B_IsNeg then
  178.     if A_IsNeg then HugeInt_Comp := -1
  179.     else HugeInt_Comp := 1
  180.  
  181.   else
  182.     begin
  183.       if A_IsNeg then HugeInt_Min(a);
  184.       if B_IsNeg then HugeInt_Min(b);
  185.       i := HugeIntMSB;
  186.       while (i > 0) and (a[i] = b[i]) do Dec(i);
  187.       if A_IsNeg then { both negative! }
  188.         if a[i] > b[i] then HugeInt_Comp := -1
  189.         else if a[i] < b[i] then HugeInt_Comp := 1
  190.         else HugeInt_Comp := 0
  191.       else { both positive }
  192.         if a[i] > b[i] then HugeInt_Comp := 1
  193.         else if a[i] < b[i] then HugeInt_Comp := -1
  194.         else HugeInt_Comp := 0;
  195.  
  196.     end;{ else }
  197. end;{ HugeInt_Comp }
  198.  
  199. procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt);
  200. { R := a + b }
  201. var
  202.   i: Integer;
  203.   h: Word;
  204. begin
  205.   h := 0;
  206.   for i := 0 to HugeIntMSB do
  207.     begin
  208.       h := h + a[i] + b[i];
  209.       R[i] := Lo(h);
  210.       h := Hi(h);
  211.     end;{ for }
  212.   HugeIntCarry := h > 0;
  213.   {$IFOPT R+ }
  214.     if HugeIntCarry then RunError(215);
  215.   {$ENDIF}
  216. end;{ HugeInt_Add }
  217.  
  218. procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt);
  219. { R := a - b }
  220.  
  221. var
  222.   i: Integer;
  223.   h: Word;
  224. begin
  225.   HugeInt_Min(b);
  226.   HugeInt_Add(a, b, R);
  227. end;{ HugeInt_Sub }
  228.  
  229. procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt);
  230. { R := a * b }
  231. var
  232.   i, j, k:          Integer;
  233.   A_end, B_end:     Integer;
  234.   A_IsNeg, B_IsNeg: Boolean;
  235.   h:                Word;
  236. begin
  237.   A_IsNeg := HugeInt_IsNeg(a);
  238.   B_IsNeg := HugeInt_IsNeg(b);
  239.   if A_IsNeg then HugeInt_Min(a);
  240.   if B_IsNeg then HugeInt_Min(b);
  241.   A_End := HugeInt_HCD(a);
  242.   B_End := HugeInt_HCD(b);
  243.  
  244.   FillChar(R, SizeOf(R), 0);
  245.   HugeIntCarry := False;
  246.   for i := 0 to A_end do
  247.     begin
  248.       h := 0;
  249.       for j:= 0 to B_end do
  250.         if (i + j) < HugeIntSize then
  251.           begin
  252.             h := h + R[i+j] + a[i] * b[j];
  253.             R[i+j] := Lo(h);
  254.             h := Hi(h);
  255.           end;{ if }
  256.       k := i + B_End + 1;
  257.       while (k < HugeIntSize) and (h > 0) do
  258.         begin
  259.           h := h + R[k];
  260.           R[k] := Lo(h);
  261.           h := Hi(h);
  262.  
  263.           Inc(k);
  264.         end;{ while }
  265.       HugeIntCarry := h > 0;
  266.      {$IFOPT R+}
  267.         if HugeIntCarry then RunError(215);
  268.      {$ENDIF}
  269.     end;{ for }
  270.   { if all's well... }
  271.   if A_IsNeg xor B_IsNeg then HugeInt_Min(R);
  272. end;{ HugeInt_Mul }
  273.  
  274. procedure HugeInt_DivMod(var a: HugeInt; b: HugeInt; var R: HugeInt);
  275. { R := a div b  a := a mod b }
  276. var
  277.   MaxShifts, s, q:  Integer;
  278.   d, e:             HugeInt;
  279.   A_IsNeg, B_IsNeg: Boolean;
  280.  
  281. begin
  282.   if HugeInt_Zero(b) then
  283.  
  284.     begin
  285.       HugeIntDiv0 := True;
  286.       Exit;
  287.     end{ if }
  288.   else HugeIntDiv0 := False;
  289.   A_IsNeg := HugeInt_IsNeg(a);
  290.   B_IsNeg := HugeInt_IsNeg(b);
  291.   if A_IsNeg then HugeInt_Min(a);
  292.   if B_IsNeg then HugeInt_Min(b);
  293.   if HugeInt_Comp(a, b) < 0 then
  294.     { a<b; no need to divide }
  295.     FillChar(R, SizeOf(R), 0)
  296.   else
  297.     begin
  298.       FillChar(R, SizeOf(R), 0);
  299.       repeat
  300.         Move(b, d, SizeOf(HugeInt));
  301.         { first work out the number of shifts }
  302.  
  303.         MaxShifts := HugeInt_HCD(a) - HugeInt_HCD(b);
  304.         s := 0;
  305.         while (s <= MaxShifts) and (HugeInt_Comp(a, d) >= 0) do
  306.           begin
  307.             Inc(s);
  308.             HugeInt_SHL(d, 1);
  309.           end;{ while }
  310.         Dec(s);
  311.         { Make a new copy of b }
  312.         Move(b, d, SizeOf(HugeInt));
  313.         { Shift d as needed }
  314.         HugeInt_ShL(d, S);
  315.         { Use e = -d for addition, faster then  subtracting d }
  316.         Move(d, e, SizeOf(HugeInt));
  317.  
  318.         HugeInt_Min(e);
  319.         Q := 0;
  320.         { while a >= d do a := a+-d and keep trek of # in Q}
  321.         while HugeInt_Comp(a, d) >= 0 do
  322.           begin
  323.             HugeInt_Add(a, e, a);
  324.             Inc(Q);
  325.           end;{ while }
  326.         { OOps!, one too many subtractions; correct }
  327.         if HugeInt_IsNeg(a) then
  328.           begin
  329.             HugeInt_Add(a, d, a);
  330.             Dec(Q);
  331.           end;{ if }
  332.         HugeInt_SHL(R, 1);
  333.         R[0] := Q;
  334.       until HugeInt_Comp(a, b) < 0;
  335.  
  336.       if A_IsNeg xor B_IsNeg then HugeInt_Min(R);
  337.     end;{ else }
  338. end;{ HugeInt_Div }
  339.  
  340. procedure HugeInt_DivMod100(var a: HugeInt; var R: Integer);
  341. { This works on positive numbers only
  342.   256-Based division: R := a mod 100; a:= a div 100; }
  343. var
  344.   Q: HugeInt;
  345.   S: Integer;
  346. begin
  347.   R := 0; FillChar(Q, SizeOf(Q), 0);
  348.   S := HugeInt_HCD(a);
  349.   repeat
  350.     r := 256*R + a[S];
  351.     HugeInt_SHL(Q, 1);
  352.     Q[0] := R div 100;
  353.     R := R mod 100;
  354.     Dec(S);
  355.   until S < 0;
  356.  
  357.   Move(Q, a, SizeOf(Q));
  358. end;{  HugeInt_DivMod100 }
  359.  
  360. procedure HugeInt_Div(a, b: HugeInt; var R: HugeInt);
  361. begin
  362.   HugeInt_DivMod(a, b, R);
  363. end;{ HugeInt_Div }
  364.  
  365. procedure HugeInt_Mod(a, b: HugeInt; var R: HugeInt);
  366. begin
  367.   HugeInt_DivMod(a, b, R);
  368.   Move(a, R, SizeOf(HugeInt));
  369. end;{ HugeInt_Mod }
  370.  
  371. procedure HugeInt2String(a: HugeInt; var S: string);
  372.   function Str100(i: Integer): string;
  373.   begin
  374.     Str100 := Chr(i div 10 + Ord('0')) + Chr(i mod 10 + Ord('0'));
  375.  
  376.   end;{ Str100 }
  377. var
  378.   R:      Integer;
  379.   Is_Neg: Boolean;
  380. begin
  381.   S := '';
  382.   Is_Neg := HugeInt_IsNeg(a);
  383.   if Is_Neg then HugeInt_Min(a);
  384.   repeat
  385.     HugeInt_DivMod100(a, R);
  386.     Insert(Str100(R), S, 1);
  387.   until HugeInt_Zero(a) or (Length(S) = 254);
  388.   while (Length(S) > 1) and (S[1] = '0') do Delete(S, 1, 1);
  389.   if Is_Neg then Insert('-', S, 1);
  390. end;{ HugeInt2String }
  391.  
  392. procedure String_DivMod256(var S: string; var R: Integer);
  393. { This works on Positive numbers Only
  394.  
  395.   10(00)-based division: R := S mod 256; S := S div 256 }
  396. var Q: string;
  397. begin
  398.   FillChar(Q, SizeOf(Q), 0);
  399.   R := 0;
  400.   while S <> '' do
  401.     begin
  402.       R := 10*R + Ord(S[1]) - Ord('0'); Delete(S, 1, 1);
  403.       Q := Q + Chr(R div 256 + Ord('0'));
  404.       R := R  mod 256;
  405.     end;{ while }
  406.   while (Q <> '') and (Q[1] = '0') do Delete(Q, 1, 1);
  407.   S := Q;
  408. end;{ String_DivMod256 }
  409.  
  410. procedure String2HugeInt(AString: string; var a: HugeInt);
  411. var
  412.   i, h:   Integer;
  413.  
  414.   Is_Neg: Boolean;
  415. begin
  416.   if AString = '' then AString := '0';
  417.   Is_Neg := AString[1] = '-';
  418.   if Is_Neg then Delete(Astring, 1, 1);
  419.   i := 0;
  420.   while (AString <> '') and (i <= HugeIntMSB) do
  421.     begin
  422.       String_DivMod256(AString, h);
  423.       a[i] := h;
  424.       Inc(i);
  425.     end;{ while }
  426.   if Is_Neg then HugeInt_Min(a);
  427. end;{ String2HugeInt }
  428.  
  429. procedure Integer2HugeInt(AInteger: Integer; var a: HugeInt);
  430. var Is_Neg: Boolean;
  431. begin
  432.   Is_Neg := AInteger < 0;
  433.  
  434.   if Is_Neg then AInteger := -AInteger;
  435.   FillChar(a, SizeOf(HugeInt), 0);
  436.   Move(AInteger, a, SizeOf(Integer));
  437.   if Is_Neg then HugeInt_Min(a);
  438. end;{ Integer2HugeInt }
  439.  
  440. end.
  441.